perm filename SHORT.F4[1,LCS] blob
sn#554895 filedate 1981-01-05 generic text, type T, neo UTF8
00100 C**** TO SHORTEN FOR22.DAT FILES FROM MS *****
00200 DIMENSION I(110)
00300 DOUBLE PRECISION NAM2
00400 1 FORMAT(' TYPE INPUT NAME '$)
00500 2 FORMAT(A5)
00600 23 FORMAT(A10)
00700 3 FORMAT(110A1)
00800 TYPE 1
00900 ACCEPT 2,NAM
01000 IF(NAM.EQ.' ')NAM='FOR22'
01100 CALL IFILE(21,NAM)
01200 4 FORMAT(' TYPE OUTPUT NAME '$)
01300 TYPE 4
01400 ACCEPT 23,NAM2
01500 CC CALL OFILE(1,NAM2)
01600 CALL DEFINE(1,0,NONO,NAM2)
01700 5 READ(21,3,END=100)I
01800 DO 6 K=110,1,-1
01900 6 IF(I(K).NE.' ')GO TO 7
02000 7 J=1
02100 8 J=J+1
02200 IF(J.GT.K)GO TO 50
02300 13 N=I(J)
02400 IF(N.NE.'.')GO TO 11
02500 IF(I(J+1).NE.'0')GO TO 10
02600 IF(I(J+2).NE.'0')GO TO 10
02700 IF(I(J+3).NE.'0')GO TO 10
02800 K=K-4
02900 DO 12 M=J,K
03000 12 I(M)=I(M+4)
03100 GO TO 13
03200 11 IF(N.NE.' ')GO TO 8
03300 10 IF(I(J+1).NE.' ')GO TO 8
03400 K=K-1
03500 DO 9 M=J,K
03600 9 I(M)=I(M+1)
03700 GO TO 10
03800 50 WRITE(1,3)(I(M),M=1,K)
03900 GO TO 5
04000 100 N='*'
04100 WRITE(1,3)N
04200 END